home *** CD-ROM | disk | FTP | other *** search
/ New Star Software Collection / NSS_Collection.iso / 3-004 ms visual basic pro 30 / 4.imz / 4.IMA / DATAFORM.FR_ / DATAFORM.bin
Text File  |  1993-04-28  |  21KB  |  854 lines

  1. VERSION 2.00
  2. Begin Form fDataForm 
  3.    BackColor       =   &H00C0C0C0&
  4.    ClientHeight    =   2520
  5.    ClientLeft      =   1815
  6.    ClientTop       =   3000
  7.    ClientWidth     =   5700
  8.    Height          =   2925
  9.    Icon            =   DATAFORM.FRX:0000
  10.    Left            =   1755
  11.    LinkTopic       =   "Form2"
  12.    MDIChild        =   -1  'True
  13.    ScaleHeight     =   2520
  14.    ScaleWidth      =   5700
  15.    Tag             =   "Dynaset"
  16.    Top             =   2655
  17.    Width           =   5820
  18.    Begin CommonDialog CMD1 
  19.       Left            =   4800
  20.       Top             =   1800
  21.    End
  22.    Begin PictureBox StatBox 
  23.       Align           =   2  'Align Bottom
  24.       BackColor       =   &H00C0C0C0&
  25.       BorderStyle     =   0  'None
  26.       Height          =   270
  27.       Left            =   0
  28.       ScaleHeight     =   282.462
  29.       ScaleMode       =   0  'User
  30.       ScaleWidth      =   5710.271
  31.       TabIndex        =   6
  32.       Top             =   2250
  33.       Width           =   5700
  34.       Begin Data Data1 
  35.          Connect         =   ""
  36.          DatabaseName    =   ""
  37.          Exclusive       =   0   'False
  38.          Height          =   270
  39.          Left            =   0
  40.          Options         =   0
  41.          ReadOnly        =   0   'False
  42.          RecordSource    =   ""
  43.          Top             =   0
  44.          Width           =   5475
  45.       End
  46.    End
  47.    Begin VScrollBar cScrollBar 
  48.       Height          =   2085
  49.       LargeChange     =   3000
  50.       Left            =   7665
  51.       SmallChange     =   300
  52.       TabIndex        =   15
  53.       Top             =   630
  54.       Visible         =   0   'False
  55.       Width           =   255
  56.    End
  57.    Begin PictureBox cFields 
  58.       BackColor       =   &H00C0C0C0&
  59.       BorderStyle     =   0  'None
  60.       Height          =   1065
  61.       Left            =   0
  62.       ScaleHeight     =   1056.48
  63.       ScaleMode       =   0  'User
  64.       ScaleWidth      =   7600.262
  65.       TabIndex        =   10
  66.       TabStop         =   0   'False
  67.       Top             =   630
  68.       Width           =   7605
  69.       Begin TextBox cFieldData 
  70.          BackColor       =   &H00FFFFFF&
  71.          DataSource      =   "Data1"
  72.          ForeColor       =   &H00000000&
  73.          Height          =   285
  74.          Index           =   0
  75.          Left            =   1665
  76.          TabIndex        =   13
  77.          Top             =   0
  78.          Visible         =   0   'False
  79.          Width           =   3255
  80.       End
  81.       Begin CheckBox cFieldCheck 
  82.          BackColor       =   &H00C0C0C0&
  83.          DataSource      =   "Data1"
  84.          Height          =   282
  85.          Index           =   0
  86.          Left            =   1680
  87.          TabIndex        =   12
  88.          Top             =   735
  89.          Visible         =   0   'False
  90.          Width           =   3270
  91.       End
  92.       Begin PictureBox cFieldPicture 
  93.          DataSource      =   "Data1"
  94.          Height          =   282
  95.          Index           =   0
  96.          Left            =   1680
  97.          ScaleHeight     =   255
  98.          ScaleWidth      =   3240
  99.          TabIndex        =   11
  100.          Top             =   315
  101.          Visible         =   0   'False
  102.          Width           =   3270
  103.       End
  104.       Begin Label cFieldName 
  105.          BackColor       =   &H00C0C0C0&
  106.          ForeColor       =   &H00000000&
  107.          Height          =   255
  108.          Index           =   0
  109.          Left            =   105
  110.          TabIndex        =   14
  111.          Top             =   0
  112.          Visible         =   0   'False
  113.          Width           =   1575
  114.       End
  115.    End
  116.    Begin PictureBox FieldHeader 
  117.       Align           =   1  'Align Top
  118.       BackColor       =   &H00C0C0C0&
  119.       BorderStyle     =   0  'None
  120.       Height          =   300
  121.       Left            =   0
  122.       ScaleHeight     =   300
  123.       ScaleMode       =   0  'User
  124.       ScaleWidth      =   5703.403
  125.       TabIndex        =   7
  126.       Top             =   330
  127.       Width           =   5700
  128.       Begin Label FieldValueLabel 
  129.          BackColor       =   &H00C0C0C0&
  130.          Caption         =   " Value:"
  131.          Height          =   252
  132.          Left            =   1680
  133.          TabIndex        =   9
  134.          Top             =   30
  135.          Width           =   2652
  136.       End
  137.       Begin Label FieldHdrLabel 
  138.          BackColor       =   &H00C0C0C0&
  139.          Caption         =   "Field Name:"
  140.          Height          =   252
  141.          Left            =   120
  142.          TabIndex        =   8
  143.          Top             =   30
  144.          Width           =   1212
  145.       End
  146.    End
  147.    Begin PictureBox TopPic 
  148.       Align           =   1  'Align Top
  149.       BackColor       =   &H00C0C0C0&
  150.       BorderStyle     =   0  'None
  151.       Height          =   330
  152.       Left            =   0
  153.       ScaleHeight     =   330
  154.       ScaleWidth      =   5700
  155.       TabIndex        =   0
  156.       Top             =   0
  157.       Width           =   5700
  158.       Begin CommandButton CancelAddBtn 
  159.          Caption         =   "C&ancel"
  160.          Height          =   330
  161.          Left            =   0
  162.          TabIndex        =   17
  163.          Top             =   0
  164.          Visible         =   0   'False
  165.          Width           =   960
  166.       End
  167.       Begin CommandButton RefreshBtn 
  168.          Caption         =   "&Refresh"
  169.          Height          =   330
  170.          Left            =   3780
  171.          TabIndex        =   16
  172.          Top             =   0
  173.          Width           =   960
  174.       End
  175.       Begin CommandButton FindBtn 
  176.          Caption         =   "&Find"
  177.          Height          =   330
  178.          Left            =   2835
  179.          TabIndex        =   5
  180.          Top             =   0
  181.          Width           =   960
  182.       End
  183.       Begin CommandButton CloseBtn 
  184.          Cancel          =   -1  'True
  185.          Caption         =   "&Close"
  186.          Height          =   330
  187.          Left            =   4725
  188.          TabIndex        =   4
  189.          Top             =   0
  190.          Width           =   960
  191.       End
  192.       Begin CommandButton DeleteBtn 
  193.          Caption         =   "&Delete"
  194.          Height          =   330
  195.          Left            =   1890
  196.          TabIndex        =   3
  197.          Top             =   0
  198.          Width           =   960
  199.       End
  200.       Begin CommandButton AddBtn 
  201.          Caption         =   "&Add"
  202.          Height          =   330
  203.          Left            =   0
  204.          TabIndex        =   2
  205.          Top             =   0
  206.          Width           =   960
  207.       End
  208.       Begin CommandButton UpdateBtn 
  209.          Caption         =   "&Update"
  210.          Height          =   330
  211.          Left            =   945
  212.          TabIndex        =   1
  213.          Top             =   0
  214.          Width           =   960
  215.       End
  216.    End
  217. End
  218. '============================================================================
  219. ' This is a fairly generic form that can be used in most cases with any
  220. ' table. I am sorry if it is confusing. There is a lot of paths to
  221. ' keep track on with adding, editing, browsing, deleting records
  222. ' on populated as well as empty tables. I have added flags where I
  223. ' felt there was no other way to achieve the correct functionality.
  224. ' I am sure that you can improve this form greatly with a little
  225. ' time and understanding of your spcific needs. There is also some
  226. ' recursion that could be trapped but hopefully, the form will be
  227. ' a good starting point for any data control app.
  228. '============================================================================
  229.  
  230. Dim FldArr() As control
  231.  
  232. Dim FDS As dynaset
  233. Dim FBM As String                  'form global bookmark
  234. Dim numFlds As Integer
  235. Dim CurrField As Integer
  236. Dim CurrRec As Long
  237. Dim TotRec As Long
  238. Dim JustUsedFind As Integer        'flag for find function
  239. Dim fResizing As Integer           'flag to avoid resize recursion
  240. Dim CancelFlag As Integer          'flag to cancel an addnew
  241.  
  242. Dim FldTop As Integer
  243.  
  244. Const EM_NOTHING = 0
  245. Const EM_EDIT = 1
  246. Const EM_ADDNEW = 2
  247.  
  248. Const FT_TRUEFALSE = 1
  249. Const FT_BYTE = 2
  250. Const FT_INTEGER = 3
  251. Const FT_LONG = 4
  252. Const FT_CURRENCY = 5
  253. Const FT_SINGLE = 6
  254. Const FT_DOUBLE = 7
  255. Const FT_DATETIME = 8
  256. Const FT_STRING = 10
  257. Const FT_BINARY = 11
  258. Const FT_MEMO = 12
  259.  
  260. Const YES = 6
  261. Const MSGBOX_TYPE = 4 + 48
  262.  
  263. Sub AddBtn_Click ()
  264.   On Error GoTo AddErr
  265.  
  266.   Data1.Recordset.AddNew
  267.   Data1.Caption = "New Record"
  268.   CancelAddBtn.Visible = True
  269.   AddBtn.Visible = False
  270.   If Data1.Recordset.RecordCount <> 0 Then
  271.     FBM = Data1.Recordset.Bookmark
  272.     FldArr(0).SetFocus
  273.   End If
  274.  
  275.   GoTo AddEnd
  276.  
  277. AddErr:
  278.   MsgBox Error$
  279.   Resume AddEnd
  280.  
  281. AddEnd:
  282.  
  283. End Sub
  284.  
  285. Sub CancelAddBtn_Click ()
  286.   On Error Resume Next
  287.  
  288.   CancelFlag = True
  289.   If FBM <> "" Then
  290.     Data1.Recordset.Bookmark = FBM
  291.   End If
  292.   If FDS.RecordCount > 0 Then
  293.     SetRecNum
  294.   End If
  295.  
  296. End Sub
  297.  
  298. Sub cFieldData_KeyPress (Index As Integer, KeyAscii As Integer)
  299.   'go to next field on an enter keypress
  300.   If KeyAscii = 13 Then
  301.     KeyAscii = 0
  302.     SendKeys "{Tab}"
  303.   End If
  304. End Sub
  305.  
  306. Sub cFieldPicture_Click (Index As Integer)
  307.   'this toggles the size of a picture control
  308.   'so it mat be viewed or compressed
  309.   If cFieldPicture(Index).Height <= 280 Then
  310.     cFieldPicture(Index).AutoSize = True
  311.   Else
  312.     cFieldPicture(Index).AutoSize = False
  313.     cFieldPicture(Index).Height = 280
  314.   End If
  315. End Sub
  316.  
  317. Sub cFieldPicture_DblClick (Index As Integer)
  318.   On Error GoTo PicErr
  319.  
  320.   CMD1.Filter = "Bitmaps (*.bmp)|*.bmp|Icons (*.ico)|*.ico|Metafiles (*.wmf)|*.wmf|All Files (*.*)|*.*"
  321.   CMD1.DialogTitle = "Select a Picture File to Load"
  322.   CMD1.FilterIndex = 1
  323.   CMD1.Action = 1
  324.  
  325.   If CMD1.Filename <> "" Then
  326.     cFieldPicture(Index).Picture = LoadPicture(CMD1.Filename)
  327.   End If
  328.  
  329.   GoTo PicEnd
  330.  
  331. PicErr:
  332.   MsgBox Error$
  333.   Resume PicEnd
  334.  
  335. PicEnd:
  336.  
  337. End Sub
  338.  
  339. Sub CloseBtn_Click ()
  340.   On Error Resume Next
  341.   Unload Me
  342. End Sub
  343.  
  344. Sub cScrollBar_Change ()
  345.   Dim t As Integer
  346.  
  347.   t = cScrollBar
  348.   If (t - FldTop) Mod 300 = 0 Then
  349.     cFields.Top = t
  350.   Else
  351.     cFields.Top = ((t - FldTop) \ 300) * 300 + FldTop
  352.   End If
  353.  
  354. End Sub
  355.  
  356. Sub Data1_Error (DataErr As Integer, Response As Integer)
  357.   MsgBox "Data error event hit err:" + Error$(DataErr)
  358. End Sub
  359.  
  360. Sub Data1_RePosition ()
  361.   Dim bm As String
  362.   Dim ds As dynaset
  363.  
  364.   If Data1.Recordset.RecordCount = 0 And Data1.EditMode <> 2 Then
  365.     Call AddBtn_Click
  366.     Exit Sub
  367.   End If
  368.  
  369.   If JustUsedFind = True Then
  370.     Set ds = Data1.Recordset.Clone()
  371.     bm = Data1.Recordset.Bookmark
  372.     ds.MoveFirst
  373.     CurrRec = 1
  374.     While ds.Bookmark <> bm
  375.       CurrRec = CurrRec + 1
  376.       ds.MoveNext
  377.     Wend
  378.     JustUsedFind = False
  379.   End If
  380.   SetRecNum
  381.  
  382. End Sub
  383.  
  384. Sub Data1_Validate (Action As Integer, Save As Integer)
  385.   On Error GoTo ValErr
  386.  
  387.   If CancelFlag Then
  388.     Save = False
  389.     CancelFlag = False
  390.     Exit Sub
  391.   End If
  392.  
  393.   'first check for a move from an addnew or edit record
  394.   If Action < 5 Then
  395.     If Save = True Then      'data changed
  396.       If Data1.EditMode = EM_ADDNEW Then
  397.         If MsgBox("Save New Record?", MSGBOX_TYPE) = YES Then
  398.           TotRec = TotRec + 1
  399.         Else
  400.           Save = False
  401.         End If
  402.       Else
  403.         If MsgBox("Commit Changes?", MSGBOX_TYPE) <> YES Then
  404.           Save = False        'loose changes
  405.         End If
  406.       End If
  407.     End If
  408.     SetRecNum
  409.   End If
  410.  
  411.   Select Case Action
  412.     Case 1          'First
  413.       CurrRec = 1
  414.  
  415.     Case 2          'Previous
  416.       If CurrRec = 1 Then Beep
  417.       If CurrRec <> 1 Then CurrRec = CurrRec - 1
  418.  
  419.     Case 3          'Next
  420.       If CurrRec = TotRec Then Beep
  421.       If CurrRec <> TotRec Then CurrRec = CurrRec + 1
  422.  
  423.     Case 4          'Last
  424.       CurrRec = TotRec
  425.  
  426.     Case 5          'AddNew
  427.       'do nothing
  428.  
  429.     Case 6          'Update
  430.       If Save = True Then
  431.         If Data1.EditMode = EM_ADDNEW Then
  432.           If MsgBox("Save New Record?", MSGBOX_TYPE) = YES Then
  433.             TotRec = TotRec + 1
  434.           Else
  435.             Save = False
  436.           End If
  437.         Else
  438.           If MsgBox("Commit Changes?", MSGBOX_TYPE) <> YES Then
  439.             Save = False
  440.           End If
  441.         End If
  442.       End If
  443.  
  444.     Case 7          'Delete
  445.       TotRec = TotRec - 1
  446.       SetRecNum
  447.  
  448.     Case 8
  449.       'set the flag for use in the reposition event
  450.       JustUsedFind = True
  451.  
  452.     Case 9          'BookMark
  453.       'do nothing"
  454.  
  455.     Case 10          'Close
  456.       If Save = True Then
  457.         If MsgBox("Commit Changes before Closing?", MSGBOX_TYPE) <> YES Then
  458.           Save = False
  459.         End If
  460.       End If
  461.  
  462.   End Select
  463.  
  464.   GoTo ValEnd
  465.  
  466. ValErr:
  467.   ShowError
  468.   Resume ValEnd
  469.  
  470. ValEnd:
  471.  
  472. End Sub
  473.  
  474. Sub DeleteBtn_Click ()
  475.   On Error GoTo DelErr
  476.  
  477.   If MsgBox("Delete Current Record?", MSGBOX_TYPE) = YES Then
  478.     Data1.Recordset.Delete
  479.     Data1.Recordset.MoveNext
  480.     FldArr(0).SetFocus
  481.   End If
  482.  
  483.   GoTo DelEnd
  484.  
  485. DelErr:
  486.   MsgBox Error$
  487.   Resume DelEnd
  488.  
  489. DelEnd:
  490.  
  491. End Sub
  492.  
  493. Sub FindBtn_Click ()
  494.   On Error GoTo FindErr
  495.   Dim bm As String, findstr As String
  496.  
  497.   findstr = InputBox("Enter Search Expression:")
  498.   If findstr = "" Then Exit Sub
  499.  
  500.   If Data1.Recordset.RecordCount > 0 Then
  501.     bm = Data1.Recordset.Bookmark
  502.   End If
  503.  
  504.   Data1.Recordset.FindFirst findstr
  505.  
  506.   'return to old record if no match was found
  507.   If Data1.Recordset.NoMatch And bm <> "" Then
  508.     Data1.Recordset.Bookmark = bm
  509.   End If
  510.  
  511.   GoTo FindEnd
  512.  
  513. FindErr:
  514.   MsgBox Error$
  515.   Resume FindEnd
  516.  
  517. FindEnd:
  518.   FldArr(0).SetFocus
  519.  
  520. End Sub
  521.  
  522. Sub Form_Load ()
  523.   Dim ds2 As dynaset
  524.   Dim Start, Finish
  525.  
  526.   On Error GoTo LoadErr
  527.  
  528.   '-------------------------------------------------------
  529.   'this is where the data control properties get
  530.   'set from whatever source they are coming from
  531.   'in this case, it is form1 controls
  532.   '-------------------------------------------------------
  533.   If gstDataType <> "ODBC" Then
  534.     Data1.DatabaseName = gCurrentDB.Name
  535.   End If
  536.   Data1.Connect = gCurrentDB.Connect
  537.   'determine if a table name or sql statement is used
  538.   If gfFromSQL = True Then
  539.     If gstDynaString = "" Then
  540.       Data1.RecordSource = fSQL.cSQLStatement
  541.     Else
  542.       Data1.RecordSource = gstDynaString
  543.     End If
  544.     Caption = "Dynaset: SQL Statement"
  545.   Else
  546.     Data1.RecordSource = fTables.cTableList
  547.     Caption = "Dynaset: " + UCase(fTables.cTableList)
  548.   End If
  549.   '-------------------------------------------------------
  550.   If gfFromSQL = True And fSQL.cPassThru = 1 Then
  551.     Data1.Options = VBDA_SQLPASSTHROUGH
  552.   End If
  553.  
  554.   Start = Timer
  555.   Data1.Refresh
  556.  
  557.   CurrRec = 1
  558.   Set ds2 = Data1.Recordset.Clone()
  559.   If ds2.BOF = False Then
  560.     ds2.MoveLast
  561.     TotRec = ds2.RecordCount
  562.   Else
  563.     TotRec = 0
  564.   End If
  565.   ds2.Close
  566.  
  567.   Width = 5805
  568.   LoadFields
  569.   Me.Show
  570.   FldArr(0).SetFocus
  571.   SetRecNum
  572.  
  573.   Finish = Timer
  574.   If VDMDI.PrefShowPerf.Checked Then
  575.     MsgBox CStr(TotRec) + " rows found in " + CStr(Finish - Start) + " seconds!", 48
  576.   End If
  577.  
  578.   GoTo LoadEnd
  579.  
  580. LoadErr:
  581.   ShowError
  582.   Unload Me
  583.   Resume LoadEnd
  584.  
  585. LoadEnd:
  586.  
  587. End Sub
  588.  
  589. Sub Form_Resize ()
  590.   On Error Resume Next
  591.  
  592.   If fResizing = True Then Exit Sub
  593.  
  594.   Dim h As Integer, i As Integer
  595.   Dim totw As Integer
  596.  
  597.   fResizing = True
  598.   If WindowState <> 1 And cFieldName(0).Visible = True Then 'not minimized
  599.     'make sure the form is lined up on a field
  600.     h = Height
  601.     If (h - 1320) Mod 300 <> 0 Then
  602.       Height = ((h - 1320) \ 300) * 300 + 1320
  603.     End If
  604.     'resize the status bar
  605.     StatBox.Top = Height - 650
  606.     'resize the scrollbar
  607.     cScrollBar.Height = StatBox.Top - (FieldHeader.Top - FieldHeader.Height) - 600
  608.     cScrollBar.Left = Width - 360
  609.     If FDS.Fields.Count > 10 Then
  610.       cFields.Width = Width - 260
  611.       totw = cScrollBar.Left - 20
  612.     Else
  613.       cFields.Width = Width - 20
  614.       totw = Width - 50
  615.     End If
  616.     FieldHeader.Width = Width - 20
  617.     'widen the fields if possible
  618.     For i = 0 To FDS.Fields.Count - 1
  619.       cFieldName(i).Width = .3 * totw
  620.       FldArr(i).Left = cFieldName(i).Width + 20
  621.       If Data1.Recordset.Fields(i).Type > 9 Then
  622.         FldArr(i).Width = .7 * totw - 270
  623.       End If
  624.     Next
  625.     FieldValueLabel.Left = FldArr(0).Left
  626.   End If
  627.  
  628.   Data1.Width = StatBox.Width
  629.   fResizing = False
  630.  
  631. End Sub
  632.  
  633. Function GetFieldWidth (t As Integer)
  634.   'determines the form control width
  635.   'based on the field type
  636.   Select Case t
  637.     Case FT_TRUEFALSE
  638.       GetFieldWidth = 850
  639.     Case FT_BYTE
  640.       GetFieldWidth = 650
  641.     Case FT_INTEGER
  642.       GetFieldWidth = 900
  643.     Case FT_LONG
  644.       GetFieldWidth = 1100
  645.     Case FT_CURRENCY
  646.       GetFieldWidth = 1800
  647.     Case FT_SINGLE
  648.       GetFieldWidth = 1800
  649.     Case FT_DOUBLE
  650.       GetFieldWidth = 2200
  651.     Case FT_DATETIME
  652.       GetFieldWidth = 2000
  653.     Case FT_STRING
  654.       GetFieldWidth = 3250
  655.     Case FT_MEMO
  656.       GetFieldWidth = 3250
  657.     Case Else
  658.       GetFieldWidth = 3250
  659.   End Select
  660.  
  661. End Function
  662.  
  663. Sub LoadFields ()
  664.    Dim t As dynaset
  665.    Dim ds As String        'temp dynaset name string
  666.  
  667.    Dim ft As Integer
  668.    Dim i As Integer
  669.  
  670.    On Error GoTo LoadFieldsErr
  671.  
  672.    Set FDS = Data1.Recordset
  673.    Set t = FDS
  674.  
  675.    'load the controls on the dynaset form
  676.    numFlds = t.Fields.Count
  677.    ReDim FldArr(numFlds)  As control
  678.    cFieldName(0).Visible = True
  679.    ft = t.Fields(0).Type
  680.    If ft = FT_TRUEFALSE Then
  681.      Set FldArr(0) = cFieldCheck(0)
  682.    ElseIf ft = FT_BINARY Then
  683.      Set FldArr(0) = cFieldPicture(0)
  684.    Else
  685.      Set FldArr(0) = cFieldData(0)
  686.    End If
  687.    FldArr(0).Visible = True
  688.    FldArr(0).Top = 0
  689.    FldArr(0).Width = GetFieldWidth(ft)
  690.  
  691.    FldArr(0).TabIndex = 0
  692.    On Error Resume Next
  693.    For i = 1 To t.Fields.Count - 1
  694.      cFields.Height = cFields.Height + 300
  695.      Load cFieldName(i)
  696.      cFieldName(i).Top = cFieldName(i - 1).Top + 300
  697.      cFieldName(i).Visible = True
  698.      ft = t.Fields(i).Type
  699.      If ft = FT_TRUEFALSE Then
  700.        Load cFieldCheck(i)
  701.        Set FldArr(i) = cFieldCheck(i)
  702.      ElseIf ft = FT_BINARY Then
  703.        Load cFieldPicture(i)
  704.        Set FldArr(i) = cFieldPicture(i)
  705.      Else
  706.        Load cFieldData(i)
  707.        Set FldArr(i) = cFieldData(i)
  708.      End If
  709.      FldArr(i).Top = FldArr(i - 1).Top + 300
  710.      FldArr(i).Visible = True
  711.      FldArr(i).Width = GetFieldWidth(ft)
  712.      FldArr(i).TabIndex = i
  713.    Next
  714.  
  715.    On Error GoTo LoadFieldsErr
  716.  
  717.    'resize main window
  718.    cFields.Top = FieldHeader.Top + FieldHeader.Height
  719.    FldTop = cFields.Top
  720.    cScrollBar = FldTop
  721.    If i <= 10 Then
  722.      Height = i * 300 + 1500
  723.      cScrollBar.Visible = False
  724.    Else
  725.      Height = 4500
  726.      Width = Width + 260
  727.      cScrollBar.Visible = True
  728.      cScrollBar.Min = FldTop
  729.      cScrollBar.Max = FldTop - (i * 300) + 3000
  730.    End If
  731.  
  732.    'display the field names
  733.    For i = 0 To t.Fields.Count - 1
  734.      cFieldName(i) = UCase(t.Fields(i).Name) + ":"
  735.    Next
  736.    
  737.    'bind the controls
  738.    On Error Resume Next   'bind even if table is empty
  739.    For i = 0 To t.Fields.Count - 1
  740.      FldArr(i).DataField = t.Fields(i).Name
  741.    Next
  742.  
  743.    GoTo LoadFieldsEnd
  744.  
  745. LoadFieldsErr:
  746.    MsgBox Error$
  747.    Resume LoadFieldsEnd
  748.  
  749. LoadFieldsEnd:
  750.  
  751. End Sub
  752.  
  753. Sub MoveBtn_Click (Index As Integer)
  754.   On Error GoTo moveerr
  755.   Dim bm As String
  756.  
  757.   If Not Data1.Recordset.BOF And Not Data1.Recordset.EOF Then
  758.     bm = Data1.Recordset.Bookmark
  759.   End If
  760.   Select Case Index
  761.     Case 0
  762.       If findval <> "" Then
  763.         Data1.Recordset.FindFirst findval
  764.       Else
  765.         Data1.Recordset.MoveFirst
  766.       End If
  767.     Case 1
  768.       If findval <> "" Then
  769.         Data1.Recordset.FindPrevious findval
  770.       Else
  771.         Data1.Recordset.MovePrevious
  772.       End If
  773.     Case 2
  774.       If findval <> "" Then
  775.         Data1.Recordset.FindNext findval
  776.       Else
  777.         Data1.Recordset.MoveNext
  778.       End If
  779.     Case 3
  780.       If findval <> "" Then
  781.         Data1.Recordset.FindLast findval
  782.       Else
  783.         Data1.Recordset.MoveLast
  784.       End If
  785.   End Select
  786.   'return to old record if no match was found
  787.   If Data1.Recordset.NoMatch And bm <> "" Then
  788.     Data1.Recordset.Bookmark = bm
  789.   End If
  790.  
  791.   GoTo moveend
  792.  
  793. moveerr:
  794.   MsgBox Error$
  795.   Resume moveend
  796.  
  797. moveend:
  798.   FldArr(0).SetFocus
  799. End Sub
  800.  
  801. Sub RefreshBtn_Click ()
  802.   On Error GoTo RefErr
  803.  
  804.   Data1.Refresh
  805.   GoTo RefEnd
  806.  
  807. RefErr:
  808.   ShowError
  809.   Resume RefEnd
  810.  
  811. RefEnd:
  812.  
  813. End Sub
  814.  
  815. Sub SetRecNum ()
  816.   If Data1.EditMode <> 2 Then
  817.     If Data1.Recordset.BOF = True Then
  818.       Data1.Caption = "Record BOF of " & TotRec
  819.     ElseIf Data1.Recordset.EOF = True Then
  820.       Data1.Caption = "Record EOF of " & TotRec
  821.     Else
  822.       Data1.Caption = "Record " & CurrRec & " of " & TotRec
  823.     End If
  824.   End If
  825.  
  826.   'reset buttons if needed
  827.   If Data1.EditMode <> 2 Then
  828.     CancelAddBtn.Visible = False
  829.     AddBtn.Visible = True
  830.   End If
  831.  
  832. End Sub
  833.  
  834. Sub UpdateBtn_Click ()
  835.   On Error GoTo UpdErr
  836.   Dim addflag As Integer
  837.  
  838.   addflag = Data1.EditMode
  839.   Data1.Recordset.Update
  840.   If addflag = 2 Then
  841.     FDS.MoveLast
  842.   End If
  843.  
  844.   GoTo UpdEnd
  845.  
  846. UpdErr:
  847.   ShowError
  848.   Resume UpdEnd
  849.  
  850. UpdEnd:
  851.  
  852. End Sub
  853.  
  854.